perm filename PK.F4[JEN,LCS]1 blob sn#662374 filedate 1982-06-04 generic text, type T, neo UTF8
	DIMENSION I(128),L(12800),LO(15000)
C	DIMENSION I(128),L(12800),LO(65000)
	TYPE 1
	ACCEPT 2,N1
	TYPE 4
	ACCEPT 2,N2
1	FORMAT(' INPUT 1 -- '$)
2	FORMAT(A5)
4	FORMAT(' OUTPUT -- '$)
10	CALL GETEXT(N1,'VRN')
	CALL EXTIN(I,128)
C GET HEADER
	CALL PUTEXT(N2,'VRN')
	I(1)=-3
	CALL EXTOUT(I,128)
	NX=12800
	K=0
	JK=0
	KA=0
5	CALL EXTIN(L,12800)
74	N=1
72	LL=L(N)
	IF(J.LE.12800)GO TO 78
	CALL EXTOUT(LO,12800)
	J=J-12800
78	IF(LL.NE.0)GO TO 71
	K=K+1
	IF(KA.EQ.0)GO TO 75
77	LO(J)=-1
	LO(J+1)=KA
C A SERIES OF 1'S
	J=J+2
	KA=0
75	N=N+1
	IF(N.LE.NX)GO TO 72
	JK=JK+100
	IF(JK.EQ.1700)GO TO 73
C 1700=ALL DONE
	TYPE 800,J,JK
800	FORMAT(2I)
	CALL EXTIN(L,12800)
	GO TO 74
71	IF(K.EQ.0)GO TO 710
	LO(J)=0
	LO(J+1)=K
C A SERIES OF 0'S
	J=J+2
	K=0
710	IF(LL.NE.-1)GO TO 76
	KA=KA+1
	GO TO 75
76	IF(KA.EQ.0)GO TO 79
	LO(J)=-1
	LO(J+1)=KA
C A SERIES OF 1'S
	J=J+2
	KA=0
79	LO(J)=L(N)
	J=J+1
	GO TO 75
73	CALL EXTOUT(LO,J)
	CALL FINEXT
	END